MACHINE LEARNING - BOOTSTRAPPING, BAGGING, BOOSTING E RANDOM FORESTS.

Autor

João Ricardo F. de Lima

Data de Publicação

16 de abril de 2024


Bootstrapping, Bagging, Boosting e Random Forests.

1 Alguns modelos preditivos costumam apresentar alta variância, outros alto viés. Nenhum destes extremos é desejável se o objetivo é maximizar a acurácia do modelo. Felizmente, ainda podemos utilizar modelos assim para tarefas preditivas, se conciliarmos com técnicas adicionais adequadas.

Aqui é mostrada as técnicas de Bootstrapping, Bagging, Boosting e Random Forests com o objetivo de aumentar o desempenho em modelos preditivos.

Bootstrapping

Bootstrapping é uma técnica estatística que permite gerar quase qualquer estatística ou estimador de interesse ao empregar a amostragem aleatória com reposição em dados observados.

A ideia desta técnica é simular múltiplos conjuntos de dados similares aos dados observados ao extrair amostras do mesmo. Cada conjunto de dados é criado ao selecionar aleatoriamente observações dos dados observados originais, com a possibilidade de que a mesma observação seja selecionada várias vezes ou nunca seja selecionada.

#setwd("~/Dropbox/tempecon/Facape")

#| fig-width: 15

# Pacotes
library(rbcb)
library(dplyr)
library(tsibble)
library(fabletools)
library(fable)
library(sidrar)
library(tidyverse)
library(forecast)
library(knitr)
library(TSstudio)
library(patchwork)
library(GetBCBData)
set.seed(1984)

# Dados
#dados <- rbcb::get_series(
#  code = c("ipca" = 433),
#  start_date = "2010-01-01",
#  end_date = "2024-01-01"
#  ) |> 
#  dplyr::mutate(date = tsibble::yearmonth(date)) |> 
#  tsibble::as_tsibble(index = date)

# Coleta e tratamento de dados
dados <- as_tibble(GetBCBData::gbcbd_get_series(
  id          = c("IPCA" = "433"),
  first.date  = "2010-01-01", 
  use.memoise = FALSE
)) |>
  dplyr::select(
    "date"     = ref.date, 
    "ipca" = value
  ) |> 
  tsibble::as_tsibble(index = date) |>
  dplyr::mutate(date = tsibble::yearmonth(date))

# No caso de se selecionar apenas alguns objetos para salvar
#save(dados, file="ipca.RData")

# Se os dados forem do próprio R, para importar é usar o ``load`` 
#load("ipca.RData")

# Modelo
modelo <- dados |>
  fabletools::model(stl = fable::AR(ipca))

# Amostras de bootstrapping
bootstrapping <- modelo |>
  fabletools::generate(
    new_data = dados, 
    times = 10, 
    bootstrap = TRUE,
    bootstrap_block_size = 8 #seleciona em blocos de 8 obs, reduz questao da autocorrelaçao da serie temporal.
    ) |>
  dplyr::select(-c(".model", "ipca"))

bootstrapping
# Previsões de bootstrap
previsao <- bootstrapping |>
  fabletools::model(ets = fable::AR(.sim)) |>
  fabletools::forecast(h = 12)

previsao
# Série original
g1 <- dados |> 
  fabletools::autoplot(.vars = ipca, size = 1) + 
  ggplot2::labs(title = "1) Série original", y = NULL, x = NULL)

# Séries simuladas de bootstrap
g2 <- bootstrapping |> 
  fabletools::autoplot(.vars = .sim) +
  fabletools::autolayer(object = dados, .vars = ipca, size = 1) + 
  ggplot2::guides(colour = "none") +
  ggplot2::labs(title = "2) Séries Bootstrap", y = NULL, x = NULL)
  
# Previsões de bootstrap
g3 <- previsao |>
  tsibble::update_tsibble(key = .rep) |>
  fabletools::autoplot(.vars = .mean) +
  fabletools::autolayer(object = dados, .vars = ipca, size = 1) + 
  ggplot2::guides(colour = "none") +
  ggplot2::labs(title = "3) Previsões Bootstrap", y = NULL, x = NULL)

# Gráfico
g1 + g2 + g3 + 
  patchwork::plot_layout(nrow = 3) +
  patchwork::plot_annotation(
    title   = "A técnica de Bootstrapping",
    caption = "Dados: IPCA/IBGE",
    theme   = ggplot2::theme(
      plot.title   = ggplot2::element_text(face = "bold", size = 22, hjust = 0.5),
      plot.caption = ggtext::element_textbox_simple()
      )
    )

As principais vantagens da técnica de bootstrapping são:

  • Simplicidade de uso e implementação;

  • Pode ser usada para obter quase qualquer estatística ou estimador;

  • É mais acurada para obter intervalos de confiança do que o uso da variância amostral ou suposições de normalidade.


Bagging

A técnica de Bootstrap aggregation ou simplesmente Bagging é um procedimento de propósito geral que possibilita justamente a redução de variância de diferentes métodos de aprendizado.

A ideia desta técnica é utilizar modelos estimados em múltiplas amostras de bootstrapping para produzir múltiplas previsões e, então, agregar estas previsões, geralmente usando uma média. Ao fazer isso, introduz-se diversidade de dados nos modelos ao estimar os mesmos em diferentes amostras de dados. Isto tende a produzir previsões mais acuradas e robustas em relação à modelos individuais.

Dado um conjunto de \(n\) observações independentes, \(Z_1, ..., Z_n\), cada uma com variância \(\sigma^2\), a variância da média \(\bar{Z}\) será dada por \(\frac{\sigma^2}{n}\).

Ou seja, calcular a média do conjunto de observações reduz a variância.

É imediato pensar que para reduzir a variância e, portanto, aumentar a acurácia da previsão de um determinado método estatístico de aprendizado basta pegar muitos conjuntos de treinamento da população, construir um modelo de previsão separado usando cada conjunto, definir e calcular a média das previsões resultantes.

Em outras palavras, calcula-se \(\hat{f}^{1}(x), \hat{f}^{2}(x), ..., \hat{f}^{B}(x)\) usando \(B\) conjuntos de treino, calcula-se a média deles de modo a obter um único modelo com baixa variância, dado por:

\[ \hat{f}_{\text{médio}}(x) = \frac{1}{B} \sum_{b=1}^{B} \hat{f}^{b} (x) \]

Isso não é muito prático já que, em geral, não se tem acesso a muitos conjuntos de treino. Assim, o quese pode fazer é aplicar a técnica de bootstrap, de modo a tomar diversas amostras do mesmo conjunto de treino. Assim, são gerados \(B\) diferentes conjuntos de treino. A partir daí, pode-se treinar o método no \(b\) conjunto de treino, de modo a obter \(\hat{f}^{*b} (x)\), finalmente obtendo a média das previsões

\[ \hat{f}_{\text{bag}}(x) = \frac{1}{B} \sum_{b=1}^{B} \hat{f}^{*b} (x) \]

o que é chamado de bagging.

Enquanto o método de bagging pode ser utilizado para aumentar a acurácia da previsão nos métodos de regressão, ele é particularmente útil para árvores de decisão.

Para aplicar o método à árvores de regressão, simplesmente se constrói \(B\) árvores de regressão usando \(B\) conjuntos de treino construídos através da aplicação de bagging.

Como as árvores individuais não são podadas, elas crescem bastante, tendo assim alta variância e baixo viés.

Assim, construir a média dessas árvores irá reduzir a variância.

As principais vantagens da técnica bagging são:

  • Costuma performar melhor do que modelos individuais;

  • Reduz o sobreajuste e a variância do modelo;

  • Pode ser executado usando computação paralela.

Considerando o exemplo acima, do Bootstrap, o uso de bagging seria como abaixo:

# Previsões bagging
bagged <- previsao |> 
  dplyr::summarise(
    bagged_mean = mean(.mean),
    bagged_min = min(.mean),
    bagged_max = max(.mean)
    )

# Previsão bagging
g4 <- dados |> 
  fabletools::autoplot(.vars = ipca, size = 1) + 
  ggplot2::geom_ribbon(
    mapping = ggplot2::aes(ymin = bagged_min, ymax = bagged_max),
    fill    = "#282f6b",
    alpha   = 0.4,
    data    = dplyr::full_join(bagged, dados, "date")
    ) +
  fabletools::autolayer(
    object = bagged, 
    .vars  = bagged_mean, 
    col    = "#282f6b",
    size   = 1
    ) +
  ggplot2::labs(title = "4) Previsão Bagging", y = NULL, x = NULL)

# Gráfico
g1 + g2 + g3 + g4 + 
  patchwork::plot_layout(nrow = 4) +
  patchwork::plot_annotation(
    title   = "A técnica Bagging",
    caption = "Dados: IPCA/IBGE",
    theme   = ggplot2::theme(
      plot.title   = ggplot2::element_text(face = "bold", size = 22, hjust = 0.5),
      plot.caption = ggtext::element_textbox_simple()
      )
    )

Previsão Desemprego com Arima e Bagging

Um outro exemplo detalhado e bem interessante da aplicação do método de bagging é mostrado abaixo.

set.seed(1984)

pnad <- sidrar::get_sidra(api = "/t/6381/n1/all/v/4099/p/all/d/v4099%201")

pnad$date <- seq(as.Date("2012-03-01"), as.Date("2024-02-01"), by = "1 month")

pnad_ts <- pnad |> 
  dplyr::select(
    "date"     = `date`,
    "desemprego" = `Valor`,
  ) |> 
  dplyr::mutate(date = tsibble::yearmonth(date)) |> 
  tsibble::as_tsibble(index = date)

# Série original
pnad_ts |> 
  fabletools::autoplot(.vars = desemprego, size = 1) + 
  ggplot2::labs(title = "PNAD - Desemprego", y = "% do Total", x = NULL)

# Divisão dos dados em Amostra de Treino e Amostra de Teste
split_pnad <- TSstudio::ts_split(ts.obj = pnad_ts, sample.out = 24)

dados_treino <- split_pnad$train
dados_teste <- split_pnad$test

# Modelo
modelo <- dados_treino |>
  fabletools::model(stl = fable::AR(desemprego)) 

modelo_fc <- dados_treino |>
  fabletools::model(stl = fable::AR(desemprego)) |>
  fabletools::forecast(h = 24)

forecast_original <- modelo_fc[,c(2,4)] |> 
  dplyr::select(
    "date"     = `date`,
    "previsao" = `.mean`
  ) 

# Amostras de bootstrapping
bootstrapping <- modelo |>
  fabletools::generate(
    new_data = dados_treino, 
    times = 10, 
    bootstrap = TRUE,
    bootstrap_block_size = 8 #seleciona em blocos de 8 obs, reduz questao da autocorrelaçao da serie temporal.
    ) |>
  dplyr::select(-c(".model", "desemprego"))

# Previsões de bootstrap
previsao <- bootstrapping |>
  fabletools::model(ets = fable::AR(.sim)) |>
  fabletools::forecast(h = 24)

# Previsões bagging
bagged <- previsao |>
  dplyr::summarise(
    bagged_mean = mean(.mean),
    bagged_min = min(.mean),
    bagged_max = max(.mean)
  )

forecast_bagged <- bagged |> 
  dplyr::select(
    "date"     = `date`,
    "previsao" = `bagged_mean`,
  ) 

# Série original
g1 <- pnad_ts |> 
  fabletools::autoplot(.vars = desemprego, size = 1) + 
  ggplot2::labs(title = "1) Série original", y = NULL, x = NULL)

# Séries simuladas de Modelo Original
g2 <- pnad_ts |> 
  fabletools::autoplot(.vars = desemprego, size = 1) +
  fabletools::autolayer(object = forecast_original, .vars = previsao, size = 1, colour = "red") + 
  ggplot2::labs(title = "2) Previsão Arima", y = NULL, x = NULL)

# Séries simuladas de bootstrap
g3 <- bootstrapping |> 
  fabletools::autoplot(.vars = .sim) +
  fabletools::autolayer(object = dados_treino, .vars = desemprego, size = 1) + 
  ggplot2::guides(colour = "none") +
  ggplot2::labs(title = "3) Séries Bootstrap", y = NULL, x = NULL)
  
# Previsões de bootstrap
g4 <- previsao |>
  tsibble::update_tsibble(key = .rep) |>
  fabletools::autoplot(.vars = .mean) +
  fabletools::autolayer(object = pnad_ts, .vars = desemprego, size = 1) + 
  ggplot2::guides(colour = "none") +
  ggplot2::labs(title = "4) Previsões Bootstrap", y = NULL, x = NULL)

# Previsão bagging
g5 <- pnad_ts |> 
  fabletools::autoplot(.vars = desemprego, size = 1) + 
  ggplot2::geom_ribbon(
    mapping = ggplot2::aes(ymin = bagged_min, ymax = bagged_max),
    fill    = "#282f6b",
    alpha   = 0.4,
    data    = dplyr::full_join(bagged, dados_treino, "date")
    ) +
  fabletools::autolayer(
    object = bagged, 
    .vars  = bagged_mean, 
    col    = "#282f6b",
    size   = 1
    ) +
  ggplot2::labs(title = "5) Previsão Bagging", y = NULL, x = NULL)

# Gráfico
g1 + g2 + g3 + g4 + g5 +
  patchwork::plot_layout(nrow = 6) +
  patchwork::plot_annotation(
    title   = "A técnica Bagging",
    caption = "Dados: IBGE",
    theme   = ggplot2::theme(
      plot.title   = ggplot2::element_text(face = "bold", size = 22, hjust = 0.5),
      plot.caption = ggtext::element_textbox_simple()
      )
    )

# Medidas de Acurácia
forecast_original <- ts(forecast_original, start = c(2022,3), freq = 24)
forecast_bagged <- ts(forecast_bagged, start = c(2022,3), freq = 24)
dados_teste <- ts(dados_teste, start = c(2022,3), freq = 24)

#Forecast do Arima
kable(forecast::accuracy(forecast_original, dados_teste))
ME RMSE MAE MPE MAPE ACF1 Theil’s U
Test set -1.330597 1.990205 1.330597 -16.3586 16.3586 0.9570851 1.720772
#Forecast do Bagging
kable(forecast::accuracy(forecast_bagged, dados_teste))
ME RMSE MAE MPE MAPE ACF1 Theil’s U
Test set -1.933844 2.816485 1.933844 -23.59014 23.59014 0.9627382 2.407886

Random Forests

Florestas aleatórias (do inglês random forests) é um método de aprendizado de máquina para tarefas de classificação, regressão e outras que constrói uma infinidade de árvores de decisão no momento do treinamento do modelo preditivo. Para tarefas de classificação, a saída da floresta aleatória é a categoria selecionada pela maioria das árvores. Para tarefas de regressão, a média ou previsão média das árvores individuais é retornada.

Florestas aleatórias é uma forma de equilibrar múltiplas árvores de decisão profundas, que individualmente tendem a sobreajuste. Dados um conjunto de dados, múltiplas amostras são extraídas usando amostragem aleatórias com reposição e árvores de decisão são treinadas em cada amostra. Durante o treinamento, um conjunto aleatório de variáveis é selecionado em cada nó da árvore. Depois do treinamento, previsões podem ser geradas ao calcular a média das previsões individuais das árvores. Ao introduzir aleatoriedade nas amostras de dados e nas variáveis consideradas, tende-se a obter melhores resultados de acurácia.

Assim, de certa forma, é a combinação dos métodos de árvore com bootstrap.

Fonte: Wikipedia

As principais vantagens do método Random Forests são:

  • Costuma ser mais acurado do que árvores de decisão individuais;

  • Reduz a variância do modelo;

  • É menos sensível a ruídos nos dados.

Exemplo

O relacionamento complexo entre variáveis é uma aplicação interessante do método Random Forests. Tome como exemplo o problema de previsão do PIB do Brasil. Diversos fatores podem afetar esta variável, como taxas de juros, inflação, desemprego, gastos do governo e outros.

O método Random Forests poderia ser utilizado para prever o PIB trimestral, separando amostras dos dados e treinando árvores de decisão individuais. Ao final deste processo, é possível obter previsões possivelmente mais acuradas combinando as previsões individuais.

# Pacotes
library(sidrar)
library(dplyr)
library(lubridate)
library(tidyr)
library(randomForest)
set.seed(1984)

# Dados SIDRA/IBGE - PIB e componentes
dados <- sidrar::get_sidra(
  api = "/t/6612/n1/all/v/all/p/all/c11255/90687,90691,90696,90707/d/v9318%202"
  ) |>
  dplyr::mutate(
    data  = lubridate::yq(`Trimestre (Código)`),
    componentes = dplyr::recode(
      .x                                 = `Setores e subsetores`,
      "PIB a preços de mercado"          = "pib",
      "Agropecuária - total"             = "agro",
      "Indústria - total"                = "ind",
      "Serviços - total"                 = "serv"
    ),
    valor = Valor,
    .keep = "none"
  ) |>
  tidyr::pivot_wider(
    id_cols     = "data",
    names_from  = "componentes",
    values_from = "valor"
  )

y <- dplyr::pull(dados, pib)
x <- dplyr::select(dados, -c(data, pib)) |> as.matrix()

# Modelo
modelo <- randomForest::randomForest(formula = pib ~ ., data = dados[-1])

# Previsao supondo que as 6 ultimas observaçoes 
#vão se repetir no futuro
previsao <- predict(object = modelo, newdata = tail(x))
previsao
  [107,]   [108,]   [109,]   [110,]   [111,]   [112,] 
318001.0 312789.7 314073.5 318072.9 321171.3 315157.0 


Boosting

Boosting é uma técnica para melhorar a acurácia de modelos preditivos ao, sequencialmente, combinar modelos fracos (tipicamente modelos simples) para formar um modelo forte.

A ideia da técnica boosting é treinar modelos preditivos sequencialmente, onde cada novo modelo tenta corrigir os erros do modelo anterior. Erros são corrigidos com a atribuição de pesos maiores, fazendo com que os modelos subsequentes errem menos. Ao final os modelos são combinados, usualmente através de média.

Fonte: Wikipedia

Em outras palavras, a técnica de Boosting é similar a de Bagging, com a exceção de que as árvores aqui crescem de forma sequencial: cada árvore cresce usando informação da árvore que cresceu anteriormente.

O Boosting não envolve aplicar bootstrap sobre o conjunto de treino, ao invés disso cada árvore é ajustada em uma versão modificada do data set original.

Assim como a técnica de Bagging, o método de Boosting envolve combinar um número grande de árvores. Entretanto, ao invés de ajustar uma única árvore sobre os dados, o método de boosting aprende devagar.

Dado um modelo corrente, ajusta-se uma árvore sobre os resíduos do modelo, ao invés da variável resposta Y. Feito isso, nós adicionamos a nova árvore à função de ajuste de modo a atualizar os resíduos.

Cada uma dessas árvores pode ser cada vez menor, com apenas alguns nós, determinado pelo parâmetro \(d\) no algoritmo. Assim, ao ajustar árvores pequenas sobre os resíduos, nós vamos aprimorando \(\hat{f}\) em áreas onde ela não performa tão bem.

O parâmetro de encolhimento \(\lambda\) reduz o processo ainda mais, permitindo diferentes formatos de árvores. Como é possível perceber, ao contrário do método de Bagging, o método de Boosting depende fortemente da forma que a árvore já foi construída.

Em resumo, o método de Boosting possui três parâmetros de ajuste:

  1. O número de árvores \(B\);

  2. O parâmetro de encolhimenot \(\lambda\), que controla a taxa sobre a qual o método aprende, sendo tipicamente notado como 0.01 ou 0.001. Pequenos valores para \(\lambda\) dependem de vários altos para \(B\) de modo a melhor performance;

  3. O parâmetro \(d\) de divisões em cada árvore, de modo a controlar a complexidade da amostra gerada.

As principais vantagens da técnica boosting são:

  • Costuma performar melhor do que modelos individuais;

  • Reduz o viés e a variância do modelo;

  • Lida com relações complexas nos dados.

Exemplo

O relacionamento complexo entre variáveis é uma aplicação interessante da técnica boosting. Tome como exemplo o problema de previsão do PIB do Brasil.

A técnica bagging poderia ser utilizada para prever o PIB trimestral, estimando um modelo com o conjunto de dados e sequencialmente corrigindo os erros ao modelar os mesmos na próxima iteração. Este processo permite agregar vários modelos fracos em um modelo forte e mais acurado.

# Pacotes
library(sidrar)
library(dplyr)
library(lubridate)
library(tidyr)
library(xgboost)
set.seed(1984)

# Dados SIDRA/IBGE - PIB e componentes
dados <- sidrar::get_sidra(
  api = "/t/6612/n1/all/v/all/p/all/c11255/90687,90691,90696,90707/d/v9318%202"
  ) |>
  dplyr::mutate(
    data  = lubridate::yq(`Trimestre (Código)`),
    componentes = dplyr::recode(
      .x                                 = `Setores e subsetores`,
      "PIB a preços de mercado"          = "pib",
      "Agropecuária - total"             = "agro",
      "Indústria - total"                = "ind",
      "Serviços - total"                 = "serv"
    ),
    valor = Valor,
    .keep = "none"
    ) |>
  tidyr::pivot_wider(
    id_cols     = "data",
    names_from  = "componentes",
    values_from = "valor"
    )

y <- dplyr::pull(dados, pib)
x <- dplyr::select(dados, -c(data, pib)) |> as.matrix()

# Modelo
modelo <- xgboost::xgboost(
  data      = x,
  label     = y,
  nrounds   = 50,
  params = list(eval_metric = "rmse")
  )
[1] train-rmse:185019.483465 
[2] train-rmse:130993.173510 
[3] train-rmse:92850.253111 
[4] train-rmse:65909.293795 
[5] train-rmse:46945.870603 
[6] train-rmse:33552.381162 
[7] train-rmse:24065.258473 
[8] train-rmse:17437.188603 
[9] train-rmse:12774.814979 
[10]    train-rmse:9503.039279 
[11]    train-rmse:7199.747990 
[12]    train-rmse:5562.097759 
[13]    train-rmse:4372.479756 
[14]    train-rmse:3448.370835 
[15]    train-rmse:2799.194907 
[16]    train-rmse:2301.922607 
[17]    train-rmse:1937.730136 
[18]    train-rmse:1636.073345 
[19]    train-rmse:1430.866587 
[20]    train-rmse:1258.905614 
[21]    train-rmse:1124.523924 
[22]    train-rmse:1043.766922 
[23]    train-rmse:977.340075 
[24]    train-rmse:875.063808 
[25]    train-rmse:825.137311 
[26]    train-rmse:725.842826 
[27]    train-rmse:665.142569 
[28]    train-rmse:617.670460 
[29]    train-rmse:561.962212 
[30]    train-rmse:508.004034 
[31]    train-rmse:488.554460 
[32]    train-rmse:442.622087 
[33]    train-rmse:397.301643 
[34]    train-rmse:382.736752 
[35]    train-rmse:354.815776 
[36]    train-rmse:328.300565 
[37]    train-rmse:300.275054 
[38]    train-rmse:280.461441 
[39]    train-rmse:250.799249 
[40]    train-rmse:234.874211 
[41]    train-rmse:218.443196 
[42]    train-rmse:202.922516 
[43]    train-rmse:186.104195 
[44]    train-rmse:169.207543 
[45]    train-rmse:155.787511 
[46]    train-rmse:139.049889 
[47]    train-rmse:131.079173 
[48]    train-rmse:120.638751 
[49]    train-rmse:111.459179 
[50]    train-rmse:104.975446 
modelo$evaluation_log
# Previsao
previsao <- predict(object = modelo, newdata = tail(x))
previsao
[1] 323148.2 315323.2 318286.5 324070.2 329287.1 321747.7

Notas de rodapé

  1. Este material está baseado em diversas postagens da Análise Macro (www.analisemacro.com.br)↩︎